home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Leser 19 / Amiga Plus Leser CD 19.iso / Online / AmigaTalk / intuition / Border.st < prev    next >
Text File  |  2002-01-16  |  3KB  |  115 lines
  1. "--------------------------------------------------"
  2. " Border Class implements control of Amiga Borders."
  3. "--------------------------------------------------"
  4.  
  5. Class Border :Glyph ! private parent !
  6. [
  7.    dispose
  8.       <primitive 187 0 private>.
  9.       private <- nil.
  10.       ^ nil
  11. |
  12.    registerTo: parentObject
  13.       " Valid parents are Windows, Screens, Requesters, & Gadgets: "
  14.       parent <- <primitive 187 5 parentObject self>
  15. |
  16.    setStartPoint: sPoint " Set the LeftEdge & TopEdge parameters: "
  17.       <primitive 187 3 0 (sPoint x) private>.
  18.       <primitive 187 3 1 (sPoint y) private>
  19. |
  20.    getStartPoint
  21.       ^ <primitive 187 2 0 private> @ <primitive 187 2 1 private>
  22. |
  23.    getBorderPens
  24.       ^ <primitive 187 2 2 private> @ <primitive 187 2 3 private>
  25. |
  26.    setBorderPens: newPensPoint
  27.       <primitive 187 3 2 (newPensPoint x) private>.
  28.       <primitive 187 3 3 (newPensPoint y) private>
  29. |
  30.    getDrawMode
  31.       ^ <primitive 187 2 4 private>
  32. |
  33.    setDrawMode: newDrawMode
  34.       <primitive 187 3 4 newDrawMode private>
  35. |
  36.    getCount
  37.       ^ <primitive 187 2 5 private>
  38. |
  39.    setCount: newCount
  40.       <primitive 187 3 5 newCount private>
  41. |
  42.    getNextBorder
  43.       ^ <primitive 187 2 6 private>
  44. |
  45.    setNextBorder: newBorder
  46.       <primitive 187 3 6 newBorder private>
  47. |
  48.    setBorderPoint: thePt to: newPoint
  49.       <primitive 187 4 thePt (newPoint x) (newPoint y) private>
  50. |
  51.    draw  " Only if parent is a Screen, Window or Requester: "
  52.       <primitive 187 6 self>
  53. |
  54.    new: numPoints
  55.       private <- <primitive 187 1 numPoints>.
  56.       ^ self
  57. ]
  58.  
  59. "---------------------------------------------------------------------"
  60. " Line Class relies on Class Border to implement a lot of its methods."
  61. "---------------------------------------------------------------------"
  62.  
  63. Class Line :Border ! private !
  64. [
  65.   makeLineFrom: fPoint to: tPoint
  66.     private <- <primitive 187 1 2>.
  67.  
  68.     super setBorderPoint: 1 to: fPoint.
  69.     super setBorderPoint: 2 to: tPoint.
  70.  
  71.     ^ self
  72. ]
  73.  
  74. "---------------------------------------------------"
  75. " Triangle Class relies on Class Border to implement"
  76. " a lot of its methods.                             "
  77. "---------------------------------------------------"
  78.  
  79. Class Triangle :Border ! private !
  80. [
  81.   makeTriangle: v1Point vert2: v2Point vert3: v3Point
  82.     private <- <primitive 187 1 4>.
  83.  
  84.     super setBorderPoint: 1 to: v1Point.
  85.     super setBorderPoint: 2 to: v2Point.
  86.     super setBorderPoint: 3 to: v3Point.
  87.     super setBorderPoint: 4 to: v1Point.
  88.  
  89.     ^ self
  90. ]
  91.  
  92. "----------------------------------------------------"
  93. " Rectangle Class relies on Class Border to implement"
  94. " a lot of its methods.                              "
  95. "----------------------------------------------------"
  96.  
  97. Class Rectangle :Border ! private !
  98. [
  99.   makeRectangleFrom: fPoint to: tPoint ! x1 y1 x2 y2 !
  100.     x1 <- fPoint x.
  101.     y1 <- fPoint y.
  102.     x2 <- tPoint x.
  103.     y2 <- tPoint y.
  104.  
  105.     private <- <primitive 187 1 5>.
  106.         
  107.     super setBorderPoint: 1 to: x1 @ y1.
  108.     super setBorderPoint: 2 to: x2 @ y1.
  109.     super setBorderPoint: 3 to: x2 @ y2.
  110.     super setBorderPoint: 4 to: x1 @ y2.
  111.     super setBorderPoint: 5 to: x1 @ y1.
  112.  
  113.     ^ self    
  114. ]
  115.